/*
 * Copyright (C) 2008,2009,2010,2011  Paulo Cesar Pereira de Andrade.
 *
 * This is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * Authors:
 *	Paulo Cesar Pereira de Andrade
 */

#include "exl.h"

/*
 * Prototypes
 */
static eint32_t
vector_dimension(eobject_t *array, eobject_t offset);

/*
 * Initialization
 */
eobject_t ellipsis_obj;
eobject_t function_obj;
eobject_t this_obj;
etag_t *void_tag;
etag_t *char_tag;
etag_t *int_tag;
etag_t *float_tag;
etag_t *function_tag;
etag_t *vararg_tag;
etag_t *string_tag;
etag_t *foreign_tag;
etag_t *pointer_tag;
etag_t *hashtable_tag;

static ehash_t	*ht_tags;

/*
 * Implementation
 */
void
init_tag(void)
{
    esymbol_t	*type;
    eobject_t	 list;

    enew_hash((eobject_t *)&ht_tags, H_string, 71);
    eadd_root((eobject_t *)&ht_tags);

    /* declare basic data types */
    type = enew_symbol(ht_language, eget_string((euint8_t *)"void", 4));
    enew_basic(type, 0);
    void_tag = type->tag;

    /* FIXME should be named just int and float */
    type = enew_symbol(ht_language, eget_string((euint8_t *)"int64_t", 7));
    enew_basic(type, 8);
    int_tag = type->tag;
    type = enew_symbol(ht_language, eget_string((euint8_t *)"float64_t", 9));
    enew_basic(type, 8);
    float_tag = type->tag;

    /* FIXME cannot be declared for now, and instead, should have a cast */
#define NT(string)							\
    enew_basic(enew_symbol(ht_language,					\
			   eget_string((euint8_t *)string,		\
				       strlen(string))),		\
	       sizeof(void*))
    NT("@mpz"); NT("@mpq"); NT("@mpr");
    NT("@shz"); NT("@shq"); NT("@shr");
    NT("@rgz"); NT("@rgq"); NT("@rgr");

    NT("@cdd"); NT("@cqq"); NT("@mpc");
		NT("@sqq"); NT("@shc");
		NT("@sqq"); NT("@rgc");
#undef NT

    /* packed types for vectors and records */
    type = enew_symbol(ht_language, eget_string((euint8_t *)"int8_t", 6));
    enew_basic(type, 1);
    type = enew_symbol(ht_language, eget_string((euint8_t *)"uint8_t", 7));
    enew_basic(type, 1);
    char_tag = type->tag;
    type = enew_symbol(ht_language, eget_string((euint8_t *)"int16_t", 7));
    enew_basic(type, 2);
    type = enew_symbol(ht_language, eget_string((euint8_t *)"uint16_t", 8));
    enew_basic(type, 2);
    type = enew_symbol(ht_language, eget_string((euint8_t *)"int32_t", 7));
    enew_basic(type, 4);
    type = enew_symbol(ht_language, eget_string((euint8_t *)"uint32_t", 8));
    enew_basic(type, 4);
    type = enew_symbol(ht_language, eget_string((euint8_t *)"uint64_t", 8));
    enew_basic(type, 8);
    type = enew_symbol(ht_language, eget_string((euint8_t *)"float32_t", 9));
    enew_basic(type, 4);

    /* FIXME at runtime, should not waste rtti information offsets
     * for the "basic" data types created above */

    ellipsis_obj = econs_nil(efixnum(tok_ellipsis));
    eadd_root(&ellipsis_obj);

    function_obj = econs_nil(efixnum(tok_FUNCTION));
    eadd_root(&function_obj);

    this_obj = econs_nil(efixnum(tok_this));
    eadd_root(&this_obj);

    /* special tag for the syntax ...[offset] */
    vararg_tag = etag_vector(null, null);

    /* generic, void*, object */
    type = enew_symbol(ht_language, eget_string((euint8_t *)"auto", 4));
    type->a_type = true;

    /* typedef uint8 string[] */
    string_tag = etag_vector(char_tag, null);
    type = enew_symbol(ht_language, eget_string((euint8_t *)"string_t", 8));
    type->a_type = true;
    type->tag = string_tag;
    type->value = string_tag;
    string_tag->name = type;

    /* typedef auto *pointer; */
    pointer_tag = etag_pointer(null);
    type = enew_symbol(ht_language, eget_string((euint8_t *)"pointer_t", 9));
    type->a_type = true;
    type->tag = pointer_tag;
    type->value = pointer_tag;
    pointer_tag->name = type;

    /* typedef auto (*function)(...); */
    v_check(1);
    list = econs_nil(ellipsis_obj);
    v_push(list);
    function_tag = etag_function(null, list);
    v_dec();
    type = enew_symbol(ht_language, eget_string((euint8_t *)"function_t", 10));
    type->a_type = true;
    type->tag = function_tag;
    type->value = function_tag;
    function_tag->name = type;

    /* hash_t type */
    hashtable_tag = etag_opaque(t_hashtable, tag_hashtable);
    type = enew_symbol(ht_language, eget_string((euint8_t *)"hash_t", 6));
    type->a_type = true;
    type->tag = hashtable_tag;
    type->value = hashtable_tag;
    hashtable_tag->name = type;
}

etag_t *
etag_object(eobject_t object)
{
    etag_t	*tag;
    etype_t	 type;
    ebool_t	 vector;
    erecord_t	*record;

    switch ((type = etype(object))) {
	case t_void:
	    tag = null;
	    break;
	case t_symbol:
	    tag = eget_bound_symbol(object)->tag;
	    break;
	case t_cons:
	    tag = etag_expression(object);
	    break;
	case t_basic:		case t_struct:		case t_class:
	case t_union:
	    /* record itself is tag signature */
	    tag = (etag_t *)eget_hash(ht_tags, object);
	    if (tag == null) {
		enew(&tag, tag);
		tag->data = object;
		tag->type = type - t_basic + tag_basic;
		eput_hash(ht_tags, (eentry_t *)tag);
	    }
	    break;
	case t_tag:
	    tag = object;
	    break;
	case t_const_string:
	    tag = string_tag;
	    break;
	case t_fixnum:
	case t_int:
	    tag = int_tag;
	    break;
	case t_float:
	    tag = float_tag;
	    break;
	    /* hashtable_t only instantiable at runtime */
	default:
	    if ((vector = evector_type_p(type)))
		type &= ~(t_const|t_vector);
	    if (type != t_void) {
		if (type >= ets_idx)
		    goto tag_object_fail;
		record = record_vector[type];
		tag = record->name->tag;
	    }
	    else
		tag = null;
	    if (vector)
		tag = etag_vector(tag, null);
	    break;
    }

    return (tag);
tag_object_fail:
    eparse_error(null, "cannot resolve object type");
}

etag_t *
etag_expression(eobject_t object)
{
    etag_t	*tag;
    esymbol_t	*field;
    esymbol_t	*symbol;
    erecord_t	*record;

    switch (etype(object)) {
	case t_symbol:
	    symbol = eget_bound_symbol(object);
	    tag = symbol->tag;
	    break;
	case t_cons:
	    switch (etype(ecar(object))) {
		case t_symbol:
		    /* function return tag is in function name */
		    symbol = eget_bound_symbol(ecar(object));
		    tag = symbol->tag;
		    break;
		case t_fixnum:
		    switch (eget_fixnum(ecar(object))) {
			case tok_vector:
			    /* if not access to varargs */
			    if (econs_p(ecadr(object)) &&
				ecadr(object) == ellipsis_obj)
				tag = vararg_tag;
			    /* vector tag */
			    else if ((tag = etag_expression(ecadr(object)))) {
				if (tag->type == tag_vector)
				    tag = ((eobject_t *)tag->data)[0];
				else if (tag->type == tag_hashtable)
				    tag = hashtable_tag;
				else
				    eparse_error(null,
						 "object is not a vector or hashtable");
			    }
			    break;
			case tok_pointer:
			    tag = etag_expression(ecadr(object));
			    if (tag == null ||
				(tag->type != tag_pointer &&
				 tag->type != tag_function))
				eparse_error(null, "object is not a pointer");
			    tag = ((eobject_t *)tag->data)[0];
			    break;
			case tok_field:
			    /* record tag */
			    tag = etag_expression(ecadr(object));
			    /* record field */
			    symbol = ecaddr(object);
			    if (!esymbol_p(symbol))
				eparse_error(null, "expecting symbol");
			    /* record object */
			    if (tag == null ||
				tag->type < tag_struct ||
				tag->type > tag_union)
				eparse_error(null, "object is not a record");
			    record = tag->data;
			    /* field tag */
			    field = eget_field(record, symbol->name);
			    if (field == null)
				eparse_error(null, "%s '%p' has no field '%p'",
					     erecord_token_string(tag->type -
								  tag_struct +
								  tok_struct),
					     record->name->name,
					     symbol->name);
			    if (tag->type == tag_union) {
				erplaca(object, efixnum(tok_type));
				object = ecdr(object);
				erplaca(ecdr(object), field->tag);
				if (econs_p(ecar(object)) &&
				    ecaar(object) == efixnum(tok_type))
				    erplaca(object, ecadar(object));
			    }
			    tag = field->tag;
			    break;
			case tok_new:
			    if (econs_p(ecadr(object)) &&
				ecaadr(object) == efixnum(tok_new_type_data))
				tag = ecadr(ecadr(object));
			    else
				tag = null;
			    break;
			case tok_type:
			    tag = ecaddr(object);
			    break;
			default:
			    tag = null;
			    break;
		    }
		    break;
		default:
		    tag = null;
		    break;
	    }
	    break;
	default:
	    tag = etag_object(object);
	    break;
    }

    return (tag);
}

etag_t *
etag_vector(etag_t *base, eobject_t list)
{
    etag_t	*tag;
    eint32_t	 size;
    eint32_t	 check;
    eint32_t	 count;
    eint32_t	 length;
    eobject_t	 object;
    erecord_t	*record;
    eobject_t	*offsets;
    eint32_t	 dimension;

    if (base == void_tag)
	eparse_error(null, "'void' cannot be instantiated");

    /* if tag is a vector of vectors */
    for (count = 1, tag = base; tag && tag->type == tag_vector;
	 tag = ((eobject_t *)tag->data)[0])
	count += eobject_length(tag->data) / sizeof(eobject_t) - 1;

    /* count dimensions and allocate vector to store values */
    if (list) {
	for (object = list; object; object = ecdr(object))
	    ++count;
    }
    else
	++count;
    v_check(1);
    enew_object((eobject_t *)&offsets, t_void, count * sizeof(eobject_t));
    v_push(offsets);

    /* first non vector tag is base type */
    offsets[0] = tag;

    /* store possible already precomputed information */
    for (count = 1, tag = base; tag && tag->type == tag_vector;
	 tag = ((eobject_t *)tag->data)[0]) {
	length = eobject_length(tag->data) - sizeof(eobject_t);
	memcpy(offsets + count, (eobject_t *)tag->data + 1, length);
	count += length / sizeof(eobject_t);
    }

    /* calculate base object size */
    length = sizeof(eobject_t);
    if (tag && tag->type == tag_basic) {
	record = tag->data;
	length = record->size;
    }

    /* store vector dimensions and check for runtime overflows */
    size = 1;
    if (list) {
	for (; list; list = ecdr(list), ++count) {
	    check = size;
	    if ((dimension = vector_dimension(offsets + count, ecar(list))))
		size *= dimension;
	    else {
		if (ecdr(list))
		    size *= sizeof(eobject_t);
		else
		    size *= length;
	    }
	    if (size < check || size > most_positive_fix32)
		eparse_error(null, "vector too large");

	    /* restart check for nested vector */
	    if (!dimension)
		size = 1;
	}
    }
    else
	offsets[1] = efixnum(0);

    /* check total vector size */
    check = size;
    size *= length;
    if (size < check || size > most_positive_fix32)
	eparse_error(null, "vector too large");

    /* check if a tag for this type already exist */
    tag = (etag_t *)eget_hash(ht_tags, offsets);
    if (tag == null) {
	enew(&tag, tag);
	tag->data = offsets;
	tag->type = tag_vector;
	eput_hash(ht_tags, (eentry_t *)tag);
    }

    v_dec();

    return (tag);
}

etag_t *
etag_function(etag_t *type, eobject_t list)
{
    etag_t	*tag;
    eint32_t	 count;
    eobject_t	 ident;
    eobject_t	*prototype;

    count = elength(list) + 1;

    v_check(1);
    enew_object((eobject_t *)&prototype, t_void, count * sizeof(eobject_t));
    v_push(prototype);
    prototype[0] = type;

    /* build function prototype tag, ignoring argument names */
    for (count = 1; list; list = ecdr(list), count++) {
	eargument(list, &type, &ident);
	prototype[count] = type;
    }

    tag = (etag_t *)eget_hash(ht_tags, prototype);
    if (tag == null) {
	enew_object((eobject_t *)&tag, t_tag, sizeof(etag_t));
	tag->data = prototype;
	tag->type = tag_function;
	eput_hash(ht_tags, (eentry_t *)tag);
    }
    v_dec();

    return (tag);
}

etag_t *
etag_pointer(etag_t *base)
{
    etag_t	*tag;
    eobject_t	*object;

    if (base == void_tag)
	eparse_error(null, "'void' cannot be instantiated");

    enew_object((eobject_t *)&object, t_void, sizeof(eobject_t) * 2);
    object[0] = base;

    /* don't match function without arguments neither vector tag */
    object[1] = object_eof;

    tag = (etag_t *)eget_hash(ht_tags, object);
    if (tag == null) {
	v_check(1);
	v_push(object);
	enew(&tag, tag);
	tag->data = object;
	tag->type = tag_pointer;
	eput_hash(ht_tags, (eentry_t *)tag);
	v_dec();
    }

    return (tag);
}

etag_t *
etag_opaque(etype_t type, etag_type_t tag_type)
{
    etag_t	*tag;
    eobject_t	 object;

    object = efixnum(type);

    tag = (etag_t *)eget_hash(ht_tags, object);
    if (tag == null) {
	enew(&tag, tag);
	tag->data = object;
	tag->type = tag_type;
	eput_hash(ht_tags, (eentry_t *)tag);
    }

    return (tag);
}

ebool_t
eargument(eobject_t list, etag_t **type_r, eobject_t *ident_r)
{
    etag_t	*tag;
    eobject_t	 form;
    etoken_t	 token;

    form = ecar(list);
    switch (etype(form)) {
	case t_tag:
	case t_void:
	    tag = form;
	    *ident_r = null;
	    break;
	case t_symbol:
	    tag = null;
	    *ident_r = form;
	    break;
	case t_cons:
	    if (form == ellipsis_obj) {
		if (ecdr(list) == null) {
		    tag = (etag_t *)form;
		    *ident_r = null;
		    break;
		}
		goto argument_fail;
	    }
	    /* FIXME must add support for default values */
	    if (efixnum_p(ecar(form))) {
		token = eget_fixnum(ecar(form));
		switch (token) {
		    case tok_struct:	case tok_union:
			form = ecadr(form);
			if (econs_p(form)) {
			    tag = ecar(form);
			    form = ecadr(form);
			}
			else {
			    tag = form;
			    form = null;
			}
			if (tag == null || !etag_p(tag))
			    goto argument_tag_fail;
			if (token == tok_struct) {
			    if (tag->type != tag_struct)
				goto argument_tag_fail;
			}
			else if (tag->type != tag_union)
			    goto argument_tag_fail;
			break;
		    default:
			tag = null;
			break;
		}
	    }
	    else {
		tag = ecar(form);
		form = ecadr(form);
	    }
	    /* in case it is not set */
	    *ident_r = null;
	    if (etypename(tag, type_declare, form, form,
			  &tag, ident_r, &form, false) != type_declare)
		goto argument_fail;
	    break;
	default:
	    argument_fail:
	    eparse_error(null, "expecting declaration or symbol");
    }

    *type_r = tag;

    return (tag != ellipsis_obj);
argument_tag_fail:
    eparse_error(null, "object is not a '%s'", erecord_token_string(token));
}

eint32_t
etypename(etag_t *tag, eint32_t state, eobject_t form, eobject_t spec,
	  etag_t **type_r, eobject_t *ident_r, eobject_t *spec_r,
	  ebool_t deftype)
{
    etag_t	*type;
    etoken_t	 token;
    eobject_t	 ident;
#if DEBUG
    eint32_t	 guard;
#endif
    eobject_t	 pointer;

    if (tag && !etag_p(tag))
	eparse_error(null, "expecting type");

#if DEBUG
    guard = 0;
#endif
    type = tag;
    pointer = efixnum(tok_pointer);
    for (;;) {
#if DEBUG
	if (++guard > 100)
	    eparse_error(null, "internal error (typename error)");
#endif
	switch (etype(spec)) {
	    case t_tag:
	    case t_void:
		if (!deftype)			goto typename_fail;
		/* FALLTHROUGH */
	    case t_symbol:
		/* spec: ident */
		ident = spec;
		goto typename_win;
	    case t_cons:
		switch (etype(ecar(spec))) {
		    case t_fixnum:
			token = eget_fixnum(ecar(spec));
			spec = ecdr(spec);
			ident = ecar(spec);
			switch (token) {
			    case tok_vector:
				/* spec: ident[...] */
				type = etag_vector(type, ecdr(spec));
				/* format for set_expression() */
				if (state == type_define)
				    erplaca(form, ident);
				switch (etype(ident)) {
				    case t_tag:
				    case t_void:
					if (!deftype)
					    goto typename_fail;
					/* FALLTHROUGH */
				    case t_symbol:
					goto typename_win;
				    case t_cons:
					break;
				    default:
					goto typename_fail;
				}
				spec = ecar(spec);
				break;
			    case tok_pointer:
				/* spec: *ident
				 *	or
				 * spec: *(ident)(alist)
				 * operator '*' may appear multiple times */
				for (;;) {
				    type = etag_pointer(type);
				    if (econs_p(ident) &&
					ecar(ident) == pointer) {
					spec = ecdr(ident);
					ident = ecar(spec);
				    }
				    else
					break;
				}
				if (econs_p(ident)) {
				    if (state) {
					spec = ident;
					ident = ecar(ident);
					if (ident == efixnum(tok_vector))
					    /* type *ident[] */
					    continue;
					goto typename_fail;
				    }
				    /* format for prototype() */
				    ident = ecar(ident);
				    switch (etype(ident)) {
					case t_symbol:
					    state = type_prototype;
					    goto typename_win;
					case t_cons:
					    break;
					default:
					    goto typename_fail;
				    }
				    spec = ecar(spec);
				}
				else {
				    /* format for set_expression() */
				    if (state == type_define)
					erplaca(form, ident);
				    switch (etype(ident)) {
					case t_tag:
					case t_void:
					    if (!deftype)
						goto typename_fail;
					    /* FALLTHROUGH */
					case t_symbol:
					    goto typename_win;
					default:
					    goto typename_fail;
				    }
				}
				break;
			    default:		goto typename_fail;
			}
			break;
		    case t_symbol:
			/* spec: ident(alist); */
			if (state)		goto typename_fail;
			ident = ecar(spec);
			state = type_prototype;
			goto typename_win;
		    case t_cons:
			ident = ecar(spec);
			switch (etype(ecar(ident))) {
			    case t_fixnum:
				token = eget_fixnum(ecar(ident));
				switch (token) {
				    case tok_field:
					/* spec: class.method() */
					if (state)	goto typename_fail;
					/* format for prototype */
					ident = ecdr(ident);
					tag = ecar(ident);
					if (!etag_p(tag) ||
					    tag->type != tag_class)
					    goto typename_fail;
					erplaca(ident, tag->data);
					state = type_method_prototype;
					goto typename_win;
					break;
				    case tok_vector:
					/* spec: (*ident)[...] */
					ident = ecdr(ident);
					type = etag_vector(type, ecdr(ident));
					/* remove vector spec */
					erplaca(spec, ecar(ident));
					break;
				    case tok_pointer:
					/* spec: *ident(alist)
					 *	or
					 * spec: *(ident)(alist) {}
					 * operator '*' may appear
					 * multiple times */
					ident = ecadr(ident);
					for (;;) {
					    type = etag_pointer(type);
					    if (econs_p(ident) &&
						ecar(ident) == pointer)
						ident = ecadr(ident);
					    else
						break;
					}
					if (econs_p(ident)) {
					    if (state)	goto typename_fail;
					    state = type_function;
					    goto typename_win;
					}
					else {
					    /* format for set_expression() */
					    v_check(1);
					    /* only need to gc protect
					     * if type == type_define */
					    v_push(spec);
					    if (state == type_define)
						erplaca(form, ident);
					    echeck_void(spec);
					    type = etag_function(type,
								 ecdr(spec));
					    v_dec();
					    switch (etype(ident)) {
						case t_tag:
						case t_void:
						    if (!deftype)
							goto typename_fail;
						    /* FALLTHROUGH */
						case t_symbol:
						    goto typename_win;
						default:
						    goto typename_fail;
					    }
					}
					break;
				    default:	goto typename_fail;
				}
				break;
			    case t_symbol:
				if (state)	goto typename_fail;
				/* spec: ident(alist) {...} */
				state = type_function;
				goto typename_win;
			    case t_cons:
				ident = ecar(ident);
				if (state)	goto typename_fail;
				/* spec: class.method(alist) {...} */
				if (ecar(ident) != efixnum(tok_field))
				    goto typename_fail;
				ident = ecdr(ident);
				tag = ecar(ident);
				state = type_method_function;
				if (!etag_p(tag) || tag->type != tag_class)
				    goto typename_fail;
				erplaca(ident, tag->data);
				goto typename_win;
			    default:		goto typename_fail;
			}
			break;
		    default:			goto typename_fail;
		}
		break;
	    default:				goto typename_fail;
	}
    }
typename_win:	/* bravo! hurray! (but there is more) */

    switch (etype(ident)) {
	case t_void:
	    if (!deftype || state != type_declare)
		goto typename_fail;
	    break;
	case t_tag:
	    if (!deftype || state != type_declare)
		goto typename_fail;
	    tag = (etag_t *)ident;
	    if (!tag->name)			goto typename_fail;
	    ident = tag->name;
	    break;
	case t_symbol:
	    if (state == type_function)		goto typename_fail;
	    break;
	case t_cons:
	    switch (state) {
		case type_function:
		case type_method_prototype:
		case type_method_function:	break;
		default:			goto typename_fail;
	    }
	    break;
	default:				goto typename_fail;
    }

    switch (state) {
	case type_function:
	case type_prototype:
	case type_method_function:
	case type_method_prototype:
	    break;
	default:
	    if (type == void_tag)
		eparse_error(null, "'void' cannot be instantiated");
	    break;
    }
    *type_r = type;
    *ident_r = ident;
    *spec_r = spec;

    return (state);
typename_fail:
    eparse_error(null, "expecting declaration");
}

void
echeck_void(eobject_t list)
{
    eobject_t	 object;

    /* first element is name (prototype) or result type (function type) */
    if (econs_p(list)) {
	object = ecdr(list);
	if (object && ecdr(object) == null) {
	    if (ecar(object) == void_tag)
		erplacd(list, null);
	}
    }
}

ebool_t
eliteral_p(eobject_t object)
{
    switch (etype(object)) {
	case t_symbol:
	case t_cons:
	    return (false);
	default:
	    return (true);
    }
}

ebool_t
etag_number_p(etag_t *tag)
{
    ebool_t	 result;
    erecord_t	*record;

    if (tag) {
	if (tag->type != tag_basic)
	    result = false;
	else {
	    record = tag->data;
	    switch (record->type) {
		/* need to test all numeric types because
		 * a record field may be used as offset
		 */
		case t_int:	case t_float:
		case t_mpz:	case t_mpq:		case t_mpr:
		case t_int8:	case t_uint8:		case t_int16:
		case t_uint16:	case t_int32:		case t_uint32:
		case t_uint64:	case t_float32:
		    result = true;
		    break;
		default:
		    result = false;
		    break;
	    }
	}
    }
    else
	/* if untyped object, assume true */
	result = true;

    return (result);
}

eint_t
etag_to_integer(etag_t *tag)
{
    etype_t	 type;
    erecord_t	*record;
    eint_t	 integer;

    if (tag && (tag->type == tag_struct || tag->type == tag_class)) {
	/* type reference before definition, but after declaration? */
	record = (erecord_t *)tag->data;
	if (record->type == t_pointer)
	    edef_record(record);
    }

    /* this must match the runtime typeof opcode */
    for (integer = 0, type = t_void; tag;) {
	switch (tag->type) {
	    case tag_basic:
		type = ((erecord_t *)tag->data)->type;
		if (integer & (t_vector | t_pointer))
		    integer |= type;
		else if (type == t_float32 || type == t_float64)
		    integer |= t_float;
		else
		    integer |= t_int;
		goto done;
	    case tag_struct:
	    case tag_class:
		type = ((erecord_t *)tag->data)->type & ~t_pointer;
		integer |= type;
		goto done;
	    case tag_vector:
		integer |= t_vector;
		tag = ((eobject_t *)tag->data)[0];
		break;
	    case tag_pointer:
		integer |= t_pointer;
		tag = ((eobject_t *)tag->data)[0];
		break;
	    case tag_function:
		integer |= t_lambda;
		goto done;
	    default:
		goto done;
	}
    }

done:
    return (integer);
}

char *
erecord_token_string(etoken_t token)
{
    char	*result;

    switch (token) {
	case tok_struct:
	    result = "struct";
	    break;
	case tok_class:
	    result = "class";
	    break;
	case tok_union:
	    result = "union";
	    break;
	default:
	    result = "object";
	    break;
    }

    return (result);
}

etype_t
etag_packed_p(etag_t *tag)
{
    etype_t	type;
    if (tag && tag->type == tag_basic) {
	switch (type = ((erecord_t *)tag->data)->type) {
	    case t_int8:	case t_uint8:
	    case t_int16:	case t_uint16:
	    case t_int32:	case t_uint32:
	    case t_int64:	case t_uint64:
	    case t_float32:	case t_float64:
		return (type);
	    default:
		break;
	}
    }
    return (t_void);
}

static eint32_t
vector_dimension(eobject_t *array, eobject_t object)
{
    eint32_t	offset;

    if (object == null) {
	offset = 0;
	*array = efixnum(0);
    }
    else if (enumber_offset(object, &offset) && offset)
	*array = efixnum(offset);
    else
	eparse_error(null, "bad vector dimension");

    return (offset);
}
